Motivation

https://research.stlouisfed.org/publications/economic-synopses/2013/08/13/mind-the-regional-output-gap/

# Read combined statistical areas: https://www.census.gov/geo/maps-data/data/cbf/cbf_msa.html
cbsa <- combined_statistical_areas(cb = FALSE, resolution = "5m", year = 2017)
trying URL 'http://www2.census.gov/geo/tiger/TIGER2017/CSA/tl_2017_us_csa.zip'
Content type 'application/zip' length 11353157 bytes (10.8 MB)
==================================================
downloaded 10.8 MB
# states
states <- states(cb = FALSE, resolution = "5m", year = 2017)
trying URL 'http://www2.census.gov/geo/tiger/TIGER2017/STATE/tl_2017_us_state.zip'
Content type 'application/zip' length 9284383 bytes (8.9 MB)
==================================================
downloaded 8.9 MB
# state gdp (Bureau of Economic Advisors: https://www.bea.gov/regional/downloadzip.cfm)
state_gdp <- read_csv('QGSP_ALL_R.csv') %>% 
                filter(IndustryId == 1)
Parsed with column specification:
cols(
  .default = col_character(),
  Region = col_integer(),
  ComponentId = col_integer(),
  IndustryId = col_integer(),
  `2006Q1` = col_integer(),
  `2006Q2` = col_integer(),
  `2006Q3` = col_integer(),
  `2006Q4` = col_integer(),
  `2007Q4` = col_integer()
)
See spec(...) for full column specifications.
number of columns of result is not a multiple of vector length (arg 1)3 parsing failures.
row # A tibble: 3 x 5 col     row   col   expected    actual             file expected   <int> <chr>      <chr>     <chr>            <chr> actual 1  1441  <NA> 57 columns 1 columns 'QGSP_ALL_R.csv' file 2  1442  <NA> 57 columns 2 columns 'QGSP_ALL_R.csv' row 3  1443  <NA> 57 columns 1 columns 'QGSP_ALL_R.csv'
# convert Quarterly data to numeric
state_gdp[, grepl( "Q" , names( state_gdp ) ) ] <- state_gdp[, grepl( "Q" , names( state_gdp ) ) ] %>%
                lapply(function(x) as.numeric(as.character(x))) 
# plot the shapes to ensure we have the metro areas
leaflet(states) %>%
  addTiles() %>%
  addPolygons() %>%
  setMapWidgetStyle()
# fortify to convert into a dataframe
state_map <- fortify(states, region="GEOID")
# join "thematic" data
# gdpDF <- plyr::join(gdp, states@data, by = "GeoFIPS")
# plotting
gdp_state <- ggplot(state_gdp, aes(map_id='GeoFIPS')) +
  geom_map(aes(fill = '2016Q1'), map=state_map, color='#ffffff', size=0.1) + 
  expand_limits(x=state_map$long,y=state_map$lat)
gdp_state +
  coord_map("albers", lat0=30, lat1=40) +
  scale_fill_colormap("State RGDP",
                      colormap = colormaps$viridis, reverse = T, discrete = F)
Error: Discrete value supplied to continuous scale

leaflet(
  sf_NPR1to1,
  options= getLeafletOptions(-1.5, -1.5)) %>%
  addPolygons(
    weight=2,color='#000000', group = 'states',
    fillOpacity = 0.6, opacity = 1, fillColor= ~getFactorPal(state)(state),
    highlightOptions = highlightOptions(weight = 4)) %>%
  addLabelOnlyMarkers(
    data=sf_NPR1to1.centers,
    label = ~as.character(state),
    labelOptions = labelOptions(
    noHide = 'T', textOnly = T,
    offset=c(-4,-10), textsize = '12px')) %>%
  setMapWidgetStyle()
# From http://leafletjs.com/examples/choropleth/us-states.js
qpal <- colorQuantile("Blues", domain = state_gdp$'2016Q1', n = 7)
leaflet(states) %>%
  setView(-96, 37.8, 4) %>%
  addPolygons(
    color = ~qpal('2016Q1'),
    weight = 2,
    opacity = 1,
    dashArray = "3",
    fillOpacity = 0.7,
    smoothFactor = 0.2,
    highlight = highlightOptions(
      weight = 5,
      color = "#666",
      dashArray = "",
      fillOpacity = 0.7,
      bringToFront = TRUE),
    label = labels,
    labelOptions = labelOptions(
      style = list("font-weight" = "normal", padding = "3px 8px"),
      textsize = "15px",
      direction = "auto")) %>%
  addLegend(pal = qpal, values = ~'2016Q1', opacity = 0.7, title = NULL,
    position = "bottomright")
Error in sum(sapply(label, function(x) { : 
  invalid 'type' (list) of argument
LS0tCnRpdGxlOiAiU3BhdGlhbCBWaXN1YWxpemF0aW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRSwgZWNobz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0KU3lzLnNldGVudihUWj0iQW1lcmljYS9DaGljYWdvIikKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkobHVicmlkYXRlKQpsaWJyYXJ5KHRpZ3JpcykKIyBsaWJyYXJ5KGdnbWFwKQojIGxpYnJhcnkobWFwdG9vbHMpCiMgIyBsaWJyYXJ5KHJnZW9zKQojICMgbGlicmFyeShyZ2RhbCkKIyBsaWJyYXJ5KGdlb2pzb25pbykKIyBsaWJyYXJ5KHNmKQojIGxpYnJhcnkodmlyaWRpcykKIyBsaWJyYXJ5KHJ2ZXN0KQoKbGlicmFyeSh0aWxlZ3JhbXNSKQpzdXBwcmVzc1BhY2thZ2VTdGFydHVwTWVzc2FnZXMobGlicmFyeSh0aWxlZ3JhbXNSKSkKbGlicmFyeShsZWFmbGV0KQpsaWJyYXJ5KGxlYWZsZXQuZXh0cmFzKQpsaWJyYXJ5KGNvbG9ybWFwKQoKIyMgZXhhbXBsZSBzY2FsZV9jb2xvcl9jb2xvcm1hcCgnY29sX25hbWUnLCBkaXNjcmV0ZSA9IFQsIGNvbG9ybWFwID0gY29sb3JtYXBzJHZpcmlkaXMsIHJldmVyc2UgPSBUKQoKI2ltcG9ydCBhIGN1c3RvbSB0aGVtZQpzb3VyY2UoImh0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9tZHZhbmRlcmdvbi9kYXRhLXZpei9tYXN0ZXIvY3VzdG9tX3RoZW1lLlIiKQpwYWxsZXRlPC0gYygiIzQ4NEVGNCIsICIjMTkyMkZGIiwgICIjMDAwOUZGIiwJIiNCMjkwMDAiLCAJIiNGRkNEMDAiKQpwYWxsZXRlMiA8LSBjKCIjNDg3MEY0IiwgIiMzRDUzOTkiLCAgIiMwMEMyRkYiLAkiI0ZGODQ0MCIsIAkiI0NDMzkxMiIpCgojIExlYWZsZXQgT3B0aW9ucwpnZXRMZWFmbGV0T3B0aW9ucyA8LSBmdW5jdGlvbihtaW5ab29tLCBtYXhab29tLCAuLi4pIHsKICBsZWFmbGV0T3B0aW9ucygKICAgIGNycyA9IGxlYWZsZXRDUlMoIkwuQ1JTLlNpbXBsZSIpLAogICAgbWluWm9vbSA9IG1pblpvb20sIG1heFpvb20gPSBtYXhab29tLAogICAgZHJhZ2dpbmcgPSBGQUxTRSwgem9vbUNvbnRyb2wgPSBGQUxTRSwKICAgIHRhcCA9IEZBTFNFLAogICAgYXR0cmlidXRpb25Db250cm9sID0gRkFMU0UgLCAuLi4pCn0KCiNGYWN0b3IgUGFsbGV0ZXMgZnJvbSBDb2xvcm1hcAojIGdldEZhY3RvclBhbCA8LSBmdW5jdGlvbihmKSB7CiMgICBjb2xvckZhY3Rvcihjb2xvcm1hcDo6Y29sb3JtYXAoCiMgICAgIGNvbG9ybWFwID0gY29sb3JtYXA6OmNvbG9ybWFwcyRoc3YsCiMgICAgIG5zaGFkZXMgPSBsZW5ndGgoZikpLCBmKQojIH0KCmdldEZhY3RvclBhbCA8LSBmdW5jdGlvbihmKSB7CiAgY29sb3JGYWN0b3IoY29sb3JtYXBzJHZpcmlkaXMsIGYpCn0KCmBgYAoKIyMgTW90aXZhdGlvbgpodHRwczovL3Jlc2VhcmNoLnN0bG91aXNmZWQub3JnL3B1YmxpY2F0aW9ucy9lY29ub21pYy1zeW5vcHNlcy8yMDEzLzA4LzEzL21pbmQtdGhlLXJlZ2lvbmFsLW91dHB1dC1nYXAvCgoKYGBgIHtyIGxvYWRpbmdfZGF0YX0KIyBSZWFkIGNvbWJpbmVkIHN0YXRpc3RpY2FsIGFyZWFzOiBodHRwczovL3d3dy5jZW5zdXMuZ292L2dlby9tYXBzLWRhdGEvZGF0YS9jYmYvY2JmX21zYS5odG1sCmNic2EgPC0gY29tYmluZWRfc3RhdGlzdGljYWxfYXJlYXMoY2IgPSBGQUxTRSwgcmVzb2x1dGlvbiA9ICI1bSIsIHllYXIgPSAyMDE3KQoKIyBzdGF0ZXMKc3RhdGVzIDwtIHN0YXRlcyhjYiA9IEZBTFNFLCByZXNvbHV0aW9uID0gIjVtIiwgeWVhciA9IDIwMTcpCgojIHN0YXRlIGdkcCAoQnVyZWF1IG9mIEVjb25vbWljIEFkdmlzb3JzOiBodHRwczovL3d3dy5iZWEuZ292L3JlZ2lvbmFsL2Rvd25sb2FkemlwLmNmbSkKc3RhdGVfZ2RwIDwtIHJlYWRfY3N2KCdRR1NQX0FMTF9SLmNzdicpICU+JSAKICAgICAgICAgICAgICAgIGZpbHRlcihJbmR1c3RyeUlkID09IDEpCiMgY29udmVydCBRdWFydGVybHkgZGF0YSB0byBudW1lcmljCnN0YXRlX2dkcFssIGdyZXBsKCAiUSIgLCBuYW1lcyggc3RhdGVfZ2RwICkgKSBdIDwtIHN0YXRlX2dkcFssIGdyZXBsKCAiUSIgLCBuYW1lcyggc3RhdGVfZ2RwICkgKSBdICU+JQogICAgICAgICAgICAgICAgbGFwcGx5KGZ1bmN0aW9uKHgpIGFzLm51bWVyaWMoYXMuY2hhcmFjdGVyKHgpKSkgCgpgYGAKCmBgYCB7ciBtYXBfc2hhcGVmaWxlfQojIHBsb3QgdGhlIHNoYXBlcyB0byBlbnN1cmUgd2UgaGF2ZSB0aGVtCgpsZWFmbGV0KHN0YXRlcykgJT4lCiAgYWRkVGlsZXMoKSAlPiUKICBhZGRQb2x5Z29ucygpICU+JQogIHNldE1hcFdpZGdldFN0eWxlKCkKYGBgCgpgYGAge3IgcmdkcH0KIyBmb3J0aWZ5IHRvIGNvbnZlcnQgaW50byBhIGRhdGFmcmFtZQpzdGF0ZV9tYXAgPC0gZm9ydGlmeShzdGF0ZXMsIHJlZ2lvbj0iR0VPSUQiKQoKIyBqb2luICJ0aGVtYXRpYyIgZGF0YQojIGdkcERGIDwtIHBseXI6OmpvaW4oZ2RwLCBzdGF0ZXNAZGF0YSwgYnkgPSAiR2VvRklQUyIpCmBgYAoKYGBge3IgcGxvdF9yZ2RwfQojIHBsb3R0aW5nCmdkcF9zdGF0ZSA8LSBnZ3Bsb3Qoc3RhdGVfZ2RwLCBhZXMobWFwX2lkPSdHZW9GSVBTJykpICsKICBnZW9tX21hcChhZXMoZmlsbCA9ICcyMDE2UTEnKSwgbWFwPXN0YXRlX21hcCwgY29sb3I9JyNmZmZmZmYnLCBzaXplPTAuMSkgKyAKICBleHBhbmRfbGltaXRzKHg9c3RhdGVfbWFwJGxvbmcseT1zdGF0ZV9tYXAkbGF0KQoKZ2RwX3N0YXRlICsKICBjb29yZF9tYXAoImFsYmVycyIsIGxhdDA9MzAsIGxhdDE9NDApICsKICBzY2FsZV9maWxsX2NvbG9ybWFwKCJTdGF0ZSBSR0RQIiwKICAgICAgICAgICAgICAgICAgICAgIGNvbG9ybWFwID0gY29sb3JtYXBzJHZpcmlkaXMsIHJldmVyc2UgPSBUUlVFLCBkaXNjcmV0ZSA9IEZBTFNFKQpgYGAKCgoKCmBgYCB7ciBjaGFydG9ncmFtX3JkZ3B9CmxlYWZsZXQoCiAgc2ZfTlBSMXRvMSwKICBvcHRpb25zPSBnZXRMZWFmbGV0T3B0aW9ucygtMS41LCAtMS41KSkgJT4lCiAgYWRkUG9seWdvbnMoCiAgICB3ZWlnaHQ9Mixjb2xvcj0nIzAwMDAwMCcsIGdyb3VwID0gJ3N0YXRlcycsCiAgICBmaWxsT3BhY2l0eSA9IDAuNiwgb3BhY2l0eSA9IDEsIGZpbGxDb2xvcj0gfmdldEZhY3RvclBhbChzdGF0ZSkoc3RhdGUpLAogICAgaGlnaGxpZ2h0T3B0aW9ucyA9IGhpZ2hsaWdodE9wdGlvbnMod2VpZ2h0ID0gNCkpICU+JQogIGFkZExhYmVsT25seU1hcmtlcnMoCiAgICBkYXRhPXNmX05QUjF0bzEuY2VudGVycywKICAgIGxhYmVsID0gfmFzLmNoYXJhY3RlcihzdGF0ZSksCiAgICBsYWJlbE9wdGlvbnMgPSBsYWJlbE9wdGlvbnMoCiAgICBub0hpZGUgPSAnVCcsIHRleHRPbmx5ID0gVCwKICAgIG9mZnNldD1jKC00LC0xMCksIHRleHRzaXplID0gJzEycHgnKSkgJT4lCiAgc2V0TWFwV2lkZ2V0U3R5bGUoKQpgYGAKCgoKYGBgIHtyfQojIEZyb20gaHR0cDovL2xlYWZsZXRqcy5jb20vZXhhbXBsZXMvY2hvcm9wbGV0aC91cy1zdGF0ZXMuanMKcXBhbCA8LSBjb2xvclF1YW50aWxlKCJCbHVlcyIsIGRvbWFpbiA9IHN0YXRlX2dkcCQnMjAxNlExJywgbiA9IDcpCgpsZWFmbGV0KHN0YXRlcykgJT4lCiAgc2V0VmlldygtOTYsIDM3LjgsIDQpICU+JQogIGFkZFBvbHlnb25zKAogICAgY29sb3IgPSB+cXBhbCgnMjAxNlExJyksCiAgICB3ZWlnaHQgPSAyLAogICAgb3BhY2l0eSA9IDEsCiAgICBkYXNoQXJyYXkgPSAiMyIsCiAgICBmaWxsT3BhY2l0eSA9IDAuNywKICAgIHNtb290aEZhY3RvciA9IDAuMiwKICAgIGhpZ2hsaWdodCA9IGhpZ2hsaWdodE9wdGlvbnMoCiAgICAgIHdlaWdodCA9IDUsCiAgICAgIGNvbG9yID0gIiM2NjYiLAogICAgICBkYXNoQXJyYXkgPSAiIiwKICAgICAgZmlsbE9wYWNpdHkgPSAwLjcsCiAgICAgIGJyaW5nVG9Gcm9udCA9IFRSVUUpLAogICAgbGFiZWwgPSBsYWJlbHMsCiAgICBsYWJlbE9wdGlvbnMgPSBsYWJlbE9wdGlvbnMoCiAgICAgIHN0eWxlID0gbGlzdCgiZm9udC13ZWlnaHQiID0gIm5vcm1hbCIsIHBhZGRpbmcgPSAiM3B4IDhweCIpLAogICAgICB0ZXh0c2l6ZSA9ICIxNXB4IiwKICAgICAgZGlyZWN0aW9uID0gImF1dG8iKSkgJT4lCiAgYWRkTGVnZW5kKHBhbCA9IHFwYWwsIHZhbHVlcyA9IH4nMjAxNlExJywgb3BhY2l0eSA9IDAuNywgdGl0bGUgPSBOVUxMLAogICAgcG9zaXRpb24gPSAiYm90dG9tcmlnaHQiKQpgYGAK